home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
digikit.zip
/
OODIGI.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-04
|
9KB
|
373 lines
{$S-,R-,V-,I-,B-,F+,O+,A-}
{Conditional defines that may affect this unit}
{$I APDEFINE.INC}
{Include OPro's define file if UseOPro is specified}
{$IFDEF UseOPro}
{$I OPDEFINE.INC}
{$ENDIF}
{*********************************************************}
{* OODIGI.PAS 1.04 *}
{* Copyright (c) Mustang Software 1992. *}
{* All rights reserved. *}
{*********************************************************}
unit OoDigi;
interface
uses
Dos,
{$IFDEF UseOPro}
OpRoot,
OpInline,
{$ENDIF}
{$IFDEF UseTPro}
TpInline,
TpMemChk,
{$ENDIF}
ApMisc,
ApPort,
ApTimer,
OoCom,
ApDigi;
type
DigiPortPtr = ^DigiPort;
DigiPort = object(AbstractPort)
constructor InitFast(ComName : ComNameType; NewBaud : LongInt);
{-Opens ComName with default line options}
constructor InitCustom(ComName : ComNameType; Baud : LongInt;
Parity : ParityType; DataBits : DataBitType;
StopBits : StopBitType;
InSize, OutSize : Word;
Options : Word);
{-Opens the ComName com port}
constructor InitKeep(ComName : ComNameType; InSize, OutSize : Word);
{-Opens ComName (without changing line options)}
{#Z+}
destructor Done; virtual;
{-Closes the com port}
{---- Low level hooks ----}
function GetLineStatus : Byte; Virtual;
procedure SetLine(Baud : LongInt; Parity : ParityType;
DataBits : DataBitType;
StopBits : StopBitType); virtual;
{-Calls device-level SetLine}
procedure GetLine(var Baud : LongInt; var Parity : ParityType;
var DataBits : DataBitType;
var StopBits : StopBitType;
FromHardware : Boolean); virtual;
{-Calls device-level GetLine}
procedure SetModem(DTR, RTS : Boolean); virtual;
{-Calls device-level SetModem}
procedure GetModem(var DTR, RTS : Boolean); virtual;
{-Calls device-level GetModem}
procedure GetChar(var C : Char); virtual;
{-Calls device-level GetChar}
procedure PeekChar(var C : Char; PeekAhead : Word); virtual;
{-Calls device-level PeekChar}
procedure PutChar(C : Char); virtual;
{-Calls device-level PutChar}
procedure StartTransmitter; virtual;
{-(Re)starts the transmit stream}
function CharReady : Boolean; virtual;
{-Returns True if at least one character has been received}
function TransReady : Boolean; virtual;
{-Returns True if it's ok to transmit one character}
procedure SendBreak; virtual;
{-Calls device-level SendBreak}
procedure ActivatePort(Restore : Boolean); virtual;
{-Calls device-level ActivatePort}
procedure DeactivatePort(Restore : Boolean); virtual;
{-Calls device-level DeactivatePort}
procedure SavePort(var PSR); virtual;
{-Calls device-level SavePort}
procedure RestorePort(var PSR); virtual;
{-Calls device-level RestorePort}
procedure GotError(StatusCode : Word); virtual;
{-Calls device-level GotError}
function GetModemStatusPrim(ClearMask : Byte) : Byte; virtual;
{-Primitive to return modem status byte and clear selected bits}
{----- Buffer management -----}
function InBuffUsed : Word; virtual;
{-Returns number of chars in input buffer}
function InBuffFree : Word; virtual;
{-Returns free space in input buffer}
function OutBuffUsed : Word; virtual;
{-Returns number of chars in output buffer}
function OutBuffFree : Word; virtual;
{-Returns free space in output buffer}
procedure FlushInBuffer; virtual;
{-Erases input buffer}
procedure FlushOutBuffer; virtual;
{-Erases output buffer}
{#Z-}
end;
implementation
function DigiPort.GetModemStatusPrim(ClearMask : Byte) : Byte; assembler;
asm
les di,Self
les di,es:[di].PR
mov dl,es:[di].PortRec.PortName
xor dh,dh
mov ah,$03
int $14
mov ah,al
and ah,ClearMask
les di,Self
les di,es:[di].PR
mov es:[di].PortRec.ModemStatus,ah
end;
constructor DigiPort.InitFast(ComName : ComNameType; NewBaud : LongInt);
begin
with DefaultLineOptions do
InitCustom(ComName, NewBaud, Parity, DataBits, StopBits, InSize, OutSize, Options);
if AsyncStatus <> ecOk then
Fail;
end;
constructor DigiPort.InitKeep(ComName : ComNameType; InSize, OutSize : Word);
begin
if not AbstractPort.Init then
Fail;
dInitPortKeep(PR, ComName, InSize, OutSize);
if AsyncStatus <> ecOk then
Fail
else
begin
ComPortName := ComName;
WaitChar := NoWaitChar;
end;
end;
constructor DigiPort.InitCustom(ComName : ComNameType; Baud : LongInt;
Parity : ParityType; DataBits : DataBitType;
StopBits : StopBitType;
InSize, OutSize : Word;
Options : Word);
begin
if not AbstractPort.Init then
Fail;
dInitPort(PR, ComName, Baud, Parity, DataBits, StopBits, InSize, OutSize, Options);
if AsyncStatus <> ecOk then
Fail
else
begin
ComPortName := ComName;
WaitChar := NoWaitChar;
end;
end;
destructor DigiPort.Done;
begin
if PR <> nil then
dDonePort(PR);
end;
function DigiPort.GetLineStatus : Byte;
begin
GetLineStatus := dGetLineStatusDirect(PR);
end;
procedure DigiPort.SetLine(Baud : LongInt;
Parity : ParityType;
DataBits : DataBitType;
StopBits : StopBitType);
begin
dSetLine(PR, Baud, Parity, DataBits, StopBits);
end;
procedure DigiPort.GetLine(var Baud : LongInt;
var Parity : ParityType;
var DataBits : DataBitType;
var StopBits : StopBitType;
FromHardware : Boolean);
begin
dGetLine(PR, Baud, Parity, DataBits, StopBits, FromHardware);
end;
procedure DigiPort.SetModem(DTR, RTS : Boolean);
begin
dSetModem(PR, DTR, RTS);
end;
procedure DigiPort.GetModem(var DTR, RTS : Boolean);
begin
dGetModem(PR, DTR, RTS);
end;
procedure DigiPort.GetChar(var C : Char);
begin
dGetChar(PR, C);
end;
procedure DigiPort.PeekChar(var C : Char; PeekAhead : Word);
begin
dPeekChar(PR, C, PeekAhead);
end;
procedure DigiPort.StartTransmitter;
begin
dStartTransmitter(PR);
end;
procedure DigiPort.PutChar(C : Char);
begin
dPutChar(PR, C);
end;
function DigiPort.CharReady : Boolean;
begin
CharReady := dCharReady(PR);
end;
function DigiPort.TransReady : Boolean;
begin
TransReady := dTransReady(PR);
end;
procedure DigiPort.SendBreak;
begin
dSendBreak(PR);
end;
procedure DigiPort.ActivatePort(Restore : Boolean);
begin
dActivatePort(PR, Restore);
end;
procedure DigiPort.DeactivatePort(Restore : Boolean);
begin
dDeactivatePort(PR, Restore);
end;
procedure DigiPort.SavePort(var PSR);
begin
dSavePort(PR, PSR);
end;
procedure DigiPort.RestorePort(var PSR);
begin
dRestorePort(PR, PSR);
end;
procedure DigiPort.GotError(StatusCode : Word);
begin
dGotError(PR, StatusCode);
end;
function DigiPort.InBuffUsed : Word; assembler;
asm
les di,Self
les di,es:di.PR
mov dl,es:[di].PortRec.PortName
xor dh,dh
mov ah,$0A
int $14
end;
function DigiPort.InBuffFree : Word;
begin
RunError(211);
end;
function DigiPort.OutBuffUsed : Word; assembler;
asm
les di,Self
les di,es:[di].PR
mov dl,es:[di].PortRec.PortName
xor dh,dh
mov ah,$12
int $14
inc ax
mov dx,ax
les di,Self
les di,es:[di].PR
mov ax,es:[di].PortRec.OutBuffLen
sub ax,dx
end;
function DigiPort.OutBuffFree : Word;
var
FreeSpace, PercentFree : Word;
begin
asm
les di,Self
les di,es:[di].PR
mov dl,es:[di].PortRec.PortName
xor dh,dh
mov ah,$12
int $14
inc ax
mov FreeSpace,ax
end;
PercentFree := (FreeSpace * LongInt(100)) div PR^.OutBuffLen;
if PercentFree > 90 then
OutBuffFree := 65535
else
OutBuffFree := 0;
end;
procedure DigiPort.FlushInBuffer; assembler;
asm
les di,Self
les di,es:[di].PR
mov dl,es:[di].PortRec.PortName
xor dh,dh
mov ah,$10
int $14
end;
procedure DigiPort.FlushOutBuffer; assembler;
asm
les di,Self
les di,es:[di].PR
mov dl,es:[di].PortRec.PortName
xor dh,dh
mov ah,$11
int $14
end;
end.